module Lan_2 where

import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.Char

(?) cond (a, b) = if cond then a else b

start_state = "q0"
eos = "END"
empty_el = "e"
empty_stack = "ES"
halt = "HALT"

delta = M.fromList
  [
    (("q0", "ID", "e"), ("q1", "e", [a0]))
  
  , (("q1", "A_OP", "e"), ("q2", "e", [a1]))

  , (("q2", "ID", "e"), ("q3", "e", [a0]))
  , (("q2", "B", "e"), ("q2", "+", [a2]))

  , (("q3", "OP", "e"), ("q2", "e", [a4]))
  , (("q3", "CB", "+"), ("q3", "e", [a6]))
  , (("q3", eos, "ES"), (halt, empty_stack, [a7]))
  ]

priority = M.fromList
  [
    ("=", 0)
  , ("(", 0)
  , (")", 0)
  , ("+", 1)
  , ("*", 2)
  ]

type StackSymbol = String
type Stack = [StackSymbol]
type Code = ([String], Integer)
type Buffer = ([String], [String], Code)
type ActionSet = (String, Stack, Buffer)
type Action = ActionSet -> ActionSet 

a0 :: Action 
a0 (n, stack, (id_buf, op_buf, code)) = 
  (n, stack, (n:id_buf, op_buf, code)) 

a1 :: Action 
a1 (n, stack, (id_buf, op_buf, code)) = 
  (n, stack, (id_buf, n:op_buf, code)) 

a2 :: Action 
a2 (n, stack, (id_buf, op_buf, code)) = 
  (n, "+":stack, (id_buf, n:op_buf, code)) 

a3 :: Action 
a3 (n, stack, (x:x':xs, y:ys, (text, num))) = 
  (n, stack, (x'':xs, ys, n_code)) 
  where
    x'' = '$' : (show (num+2))
    n_code = 
      case y of
        "=" -> (text ++ (load x) ++ (store' x'), num)
        "+" -> (text ++ gen add, num+2)
        "*" -> (text ++ gen mpy, num+2) 
    
    gen func = (load x) 
            ++ (store (num+1))
            ++ (load x')
            ++ (func ('$' : (show (num+1))))
            ++ (store (num+2))
    mod_name name = (isDigit $ head name) ? ('=' : name, name)
    load name = ["LOAD " ++ (mod_name name)]
    store num = ["STORE " ++ ('$' : (show num))]
    store' name = ["STORE " ++ name]
    add name  = ["ADD " ++ name]
    mpy name = ["MPY " ++ name]

a4 :: Action
a4 set@(cur_op, _, (_, h_op:_, _)) = res 
  where
    p op = M.findWithDefault 0 op priority
    res = if (p cur_op) >= (p h_op)
          then a1 set
          else a4 $ a3 set
    
a5 :: Action 
a5 (n, x:xs, (id_buf, y:ys, code)) = 
  (n, xs, (id_buf, ys, code)) 

a6 :: Action
a6 set@(_, _, (_, h_op:_, _)) = 
  if h_op == "("
  then a5 set
  else a6 $ a3 set 

a7 :: Action
a7 set@(_, _, (_, op_buf, _)) =
  if null op_buf
  then set
  else a7 $ a3 set
